Power Tools for Macintosh/Power Tools for Macintosh (SoftBit)(1992).iso/Stacks/*F-I/HyperCard Utilities/SendSerial ƒ/SendSerial.p

Text File | 1987-05-08 | 5.2 KB | 250 lines | [TEXT/MPS ]

{$R-}
{$D+}
(*
    SendSerial --     a WildCard user-defined command
                    send bytes out the serial port (at specified baud rate).

    example 1:
        SendSerial ">1200 AX4500"

        sends the string AX4500 out the modem port at 1200 baud.
        If no baud rate is specified it defaults to 9600.

    example 2:
        SendSerial "AX4500^0D"

        sends the string AX4500<CR> out the modem port at 9600 baud.
        The ^ indicates two hex didgits to follow. (Two ^^ means ^)

    To compile and link this file using Macintosh Programmer's Workshop,

    pascal SendSerial.p
    link -o Test -sn Main=SendSerial -sn STDIO=SendSerial ∂
         -sn INTENV=SendSerial -rt WCMD=111 ∂
         SendSerial.p.o {MPW}libraries:interface.o

    then use ResEdit to copy the resulting WCMD from Test
    and paste it into WildCard, the Home stack, or your own stack.
*)

UNIT DummyUnit;

INTERFACE

   USES MemTypes, QuickDraw, OsIntf;

IMPLEMENTATION

const debug = false;

PROCEDURE SendSerial(commandPtr: Ptr);                            FORWARD;

   PROCEDURE EntryPoint(arg: Ptr);
   { entry point cannot have local procs, but forward routines can }
   BEGIN
     SendSerial(arg);
   END;

   PROCEDURE SendSerial(commandPtr: Ptr);
   VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
       message, tempStr: Str255;
       refNum: INTEGER;
       err: INTEGER;
       baudRate: INTEGER;

     Procedure Error;
     BEGIN
        SysBeep(1);
        Exit (SendSerial);
     END;

     PROCEDURE OpenSerial;
     VAR handShake: SerShk;
          bRate: INTEGER;
     BEGIN
       { for now, use modem port so we don't mess with AppleTalk }
       bRate := baudRate;
       err := FSOpen('.AOUT',0,refNum);
       IF err = 0 THEN
         BEGIN
           WITH handShake DO
             BEGIN
               fXon := 1;
               fCTS := 1;
               xon  := CHR(17);
               xoff := CHR(19);
               errs := 0;
               evts := 0;
               fInx := 0;
             END;
           err := SerHShake(refNum,handShake);
           IF err = 0 THEN
             err := Control(refNum,13,@bRate);
         END;
        if debug then
            BEGIN
            MoveTo (150,30);
            DrawString('Opened Serial');
            end;
     END;


     PROCEDURE CloseSerial;
     BEGIN
       err := FSClose(refNum);
        if debug then
            BEGIN
            MoveTo (150,90);
            DrawString('closed Serial');
            end;
     END;


     PROCEDURE SendCommand(cmd: Str255);
     VAR count: LongInt;
     BEGIN
        if debug then
            BEGIN
            MoveTo (150,60);
            DrawString('About to FSWrite');
            end;
       count := Length(cmd);
       err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
        if debug then
            BEGIN
            MoveTo (250,60);
            DrawString('FSWrote');
            end;
     END;

     PROCEDURE GetMessage;
     VAR charNum: INTEGER;
         msgChar: CHAR;

         PROCEDURE SetBaudRate;
             VAR ch: CHAR;
         BEGIN
           baudRate := 0;
           ch := CHR(commandPtr^);
           if debug then MoveTo(50,100);
           WHILE ch <> ' ' DO
                   BEGIN
                if debug then
                    DrawChar(ch);
                IF (ch < '0') OR (ch > '9') THEN
                    Error;
                baudRate := 10*baudRate + ORD(CHR(commandPtr^)) - ORD('0');
                commandPtr := Pointer(Ord(commandPtr)+1);
                   ch := CHR(commandPtr^);
                END;
         END;

         FUNCTION GetHex: CHAR;
             VAR ch: CHAR;
                hex: INTEGER;
         BEGIN
             ch := CHR(commandPtr^);
            IF ch = '^' THEN {two ^'s means really want a ^}
                GetHex := '^'
             ELSE
                BEGIN
                IF (ch >= '0') AND (ch <= '9') THEN
                    hex := ORD(ch) - ORD('0')
                ELSE IF (ch >= 'a') AND (ch <= 'f') THEN
                    hex := 10 + ORD(ch) - ORD('a')
                ELSE IF (ch >= 'A') AND (ch <= 'F') THEN
                    hex := 10 + ORD(ch) - ORD('A')
                ELSE
                    Error;

                   commandPtr := Pointer(Ord(commandPtr)+1);

                ch := CHR(commandPtr^);
                IF (ch >= '0') AND (ch <= '9') THEN
                    hex := 16*hex + ORD(ch) - ORD('0')
                ELSE IF (ch >= 'a') AND (ch <= 'f') THEN
                    hex := 16*hex + 10 + ORD(ch) - ORD('a')
                ELSE IF (ch >= 'A') AND (ch <= 'F') THEN
                    hex := 16*hex + 10 + ORD(ch) - ORD('A')
                ELSE
                    Error;

                GetHex := CHR(hex);
                END;
               commandPtr := Pointer(Ord(commandPtr)+1);
         END;

     BEGIN
       { skip command name }
       WHILE (commandPtr^ <> 0) AND (commandPtr^ <> 13) AND (CHR(commandPtr^) <> ' ') DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { skip following white space }
       WHILE CHR(commandPtr^) = ' ' DO
         commandPtr := Pointer(Ord(commandPtr)+1);

       { see if baud rate specified }
       IF CHR(commandPtr^) = '>' THEN
            BEGIN
         commandPtr := Pointer(Ord(commandPtr)+1);
         IF CHR(commandPtr^) <> '>' THEN
             BEGIN
             SetBaudRate;
               { skip following white space }
               WHILE CHR(commandPtr^) = ' ' DO
                 commandPtr := Pointer(Ord(commandPtr)+1);
            END;
         END;


       { extract the rest into a Str255 }
       charNum := 0;
       WHILE (commandPtr^ <> 0) AND (charNum < 255) DO
         BEGIN
           msgChar := CHR(commandPtr^);
           commandPtr := Pointer(Ord(commandPtr)+1);
           charNum := charNum + 1;
           IF msgChar = '^' THEN
                   msgChar := GetHex;
           message[charNum] := msgChar;
         END;

       message[0] := CHR(charNum);

     if debug then
         begin
        moveTo(50,140);
        drawstring(message);
        end;
     END;



   BEGIN {SendSerial}
        baudRate := 9600;
     GetMessage;

     OpenSerial;
     IF err <> 0 THEN
       BEGIN
         SysBeep(1);
         EXIT(SendSerial);
       END;

     SendCommand(message);

     CloseSerial;

     if debug then
         begin
        moveTo(50,180);
        drawstring('Finis');
        end;

   END;

END.